home *** CD-ROM | disk | FTP | other *** search
/ Aminet 1 (Walnut Creek) / Aminet - June 1993 [Walnut Creek].iso / aminet / misc / amag / 9301b.lha / Devices (Folge 3) / Terminal.mod < prev    next >
Text File  |  1992-04-18  |  10KB  |  410 lines
  1. MODULE Terminal;
  2.  
  3. FROM Arts IMPORT
  4.     BreakPoint, returnVal, kickVersion;
  5. FROM DosD IMPORT
  6.     diskInfo, FileHandlePtr, InfoData, newFile,
  7.     oldFile, StandardPacket;
  8. FROM DosL IMPORT
  9.     Close, FPuts, FRead, FWrite, IsInteractive, Open,
  10.     Read, Write;
  11. FROM ExecD IMPORT
  12.     execBase, MemReqs, MemReqSet, Message, message,
  13.     MsgPortPtr, openFail, read, write;
  14. FROM ExecL IMPORT
  15.     AllocMem, CloseDevice, CreateMsgPort, DeleteMsgPort,
  16.     DoIO, FindName,    Forbid, FreeMem, GetMsg, OpenDevice,
  17.     Permit, PutMsg, RemDevice, ReplyMsg,
  18.     SendIO, Wait, WaitIO, WaitPort;
  19. FROM ExecSupport IMPORT
  20.     AbortIO, BeginIO;
  21. FROM IntuitionD IMPORT
  22.     IDCMPFlags, IDCMPFlagSet, IntuiMessagePtr, WindowPtr;
  23. FROM IntuitionL IMPORT
  24.     ModifyIDCMP;
  25. FROM Serial IMPORT
  26.     Error, IOExtSer, IOExtSerPtr, query, serialName,
  27.     SerFlags, setParams;
  28. FROM SYSTEM IMPORT
  29.     ADDRESS, ADR, BPTR, CAST, LONGSET, TSIZE;
  30.  
  31.  
  32. CONST
  33.     TxTitle = "CON:0/0/500/100/ Terminal-Send ";
  34.     RxTitle = "CON:0/101/500/100/ Terminal-Receive ";
  35.  
  36.     Senden  =  "\nSende Textdatei\n\n";
  37.     Empfang =  "\nwarte auf Textdatei\n\n";
  38.     Beendet =  "\nÜbertragung beendet\n\n";
  39.  
  40.  
  41.     Unit0 = 0;   (* festeingebaute serielle Schnittstelle *)
  42.  
  43.   (*
  44.     Doppelt ausgelegte Datenstrukturen
  45.     Sendeteil:     Empfangsteil:
  46.   *)
  47. VAR
  48.     txRequest,     rxRequest : IOExtSer;
  49.  
  50.     txWin,         rxWin     : FileHandlePtr;
  51.     txWinPtr,      rxWinPtr  : WindowPtr;
  52.  
  53.     rxPuffer,      txPuffer  : ARRAY[0..511] OF CHAR;
  54.  
  55.  
  56. PROCEDURE GetWinPointer (winHdl : FileHandlePtr;
  57.                          VAR winPtr : WindowPtr);
  58.  
  59. TYPE GetBlock = RECORD
  60.                   stdPkt : StandardPacket;
  61.                   info   : InfoData;
  62.                 END;
  63.      GetBlockPtr = POINTER TO GetBlock;
  64. VAR
  65.     portPtr  : MsgPortPtr;
  66.     pktPtr   : GetBlockPtr;
  67.  
  68. BEGIN
  69.   winPtr := NIL;
  70.   IF IsInteractive(winHdl) THEN
  71.     portPtr := CreateMsgPort();
  72.     IF portPtr # NIL THEN
  73.       pktPtr := AllocMem(TSIZE(GetBlock), MemReqSet{memClear, public});
  74.       IF pktPtr # NIL THEN
  75.         WITH pktPtr^.stdPkt DO
  76.           WITH pkt DO
  77.             link := ADR(msg);
  78.             port := ADDRESS(portPtr);
  79.             type := diskInfo;
  80.             arg1 := CAST(LONGINT, BPTR(ADR(pktPtr^.info)));
  81.           END;
  82.           WITH msg DO
  83.             node.name := ADR(pktPtr^.stdPkt.pkt);
  84.             node.type := message;
  85.             length := SIZE(pktPtr^);
  86.           END;
  87.         END;
  88.         PutMsg(winHdl^.type, pktPtr);
  89.  
  90.         REPEAT
  91.           WaitPort(portPtr);
  92.         UNTIL GetMsg(portPtr) = pktPtr;
  93.  
  94.         DeleteMsgPort(portPtr);
  95.         WITH pktPtr^ DO
  96.           IF (stdPkt.pkt.res1 # 0) AND (info.volumeNode # NIL) THEN
  97.             winPtr := CAST(ADDRESS, info.volumeNode);
  98.           END;
  99.         END;
  100.         FreeMem(pktPtr, TSIZE(GetBlock));
  101.       ELSE
  102.         DeleteMsgPort(portPtr);
  103.       END;
  104.     END;
  105.   END;
  106. END GetWinPointer;
  107.  
  108.  
  109. PROCEDURE MakeWindow(namePtr  : ADDRESS;
  110.                      VAR winPtr  : WindowPtr;
  111.                      VAR fileHdl : FileHandlePtr);
  112.  
  113. BEGIN
  114.   fileHdl := Open(namePtr, newFile);
  115.   IF fileHdl # NIL THEN
  116.     GetWinPointer(fileHdl, winPtr);
  117.   END;
  118. END MakeWindow;
  119.  
  120.  
  121. PROCEDURE WindowsAngelegt() : BOOLEAN;
  122.  
  123. VAR angelegt :BOOLEAN;
  124.  
  125. BEGIN
  126.   angelegt := FALSE;
  127.   MakeWindow(ADR(TxTitle), txWinPtr, txWin);
  128.   IF txWinPtr # NIL THEN
  129.     angelegt := TRUE;
  130.     ModifyIDCMP(txWinPtr, IDCMPFlagSet{rawKey, vanillaKey});
  131.     MakeWindow(ADR(RxTitle), rxWinPtr, rxWin);
  132.     IF rxWinPtr = NIL THEN
  133.       angelegt := FALSE;       (* für rxWin Keys ausfiltern *)
  134.       Close(txWin);
  135.       txWin := NIL;
  136.     END;
  137.   ELSIF txWin # NIL THEN
  138.     Close(txWin);
  139.   END;
  140.   RETURN angelegt;
  141. END WindowsAngelegt;
  142.  
  143.  
  144. PROCEDURE SetBaudRate(VAR serPtr : IOExtSerPtr);
  145.  
  146. BEGIN
  147.   WITH serPtr^ DO
  148.     baud := 9600;
  149.     ioSer.command := setParams;
  150.   END;
  151.   DoIO(serPtr);
  152. END SetBaudRate;
  153.  
  154.  
  155. PROCEDURE InitSerialDev(serPtr : IOExtSerPtr;
  156.                         cmnd : INTEGER) : BOOLEAN;
  157.  
  158. VAR portPtr   : MsgPortPtr;
  159.     erfolg : BOOLEAN;
  160.  
  161. BEGIN
  162.   erfolg := FALSE;
  163.   portPtr := CreateMsgPort();
  164.   IF portPtr # NIL THEN
  165.     WITH serPtr^ DO
  166.       INCL(serFlags, shared);
  167.       WITH ioSer DO
  168.         length   := 1;
  169.         message.replyPort := portPtr;
  170.       END;
  171.     END;
  172.     OpenDevice(ADR(serialName), Unit0, serPtr, LONGSET{});
  173.     IF serPtr^.ioSer.error # openFail THEN
  174.       erfolg := TRUE;
  175.  
  176.       SetBaudRate(serPtr);
  177.       serPtr^.ioSer.command := cmnd;
  178.     ELSE
  179.       WITH serPtr^.ioSer.message DO
  180.         DeleteMsgPort(replyPort);
  181.         replyPort := NIL;
  182.       END;
  183.     END;
  184.   END;
  185.   RETURN (erfolg);
  186. END InitSerialDev;
  187.  
  188.  
  189. PROCEDURE SerialVorbereitet() : BOOLEAN;
  190.  
  191. VAR vorbereitet : BOOLEAN;
  192.  
  193. BEGIN
  194.   IF InitSerialDev(ADR(txRequest), write) THEN
  195.     vorbereitet := TRUE;
  196.     txRequest.ioSer.data := ADR(txPuffer);
  197.     IF InitSerialDev(ADR(rxRequest), read) THEN
  198.       rxRequest.ioSer.data := ADR(rxPuffer);
  199.     ELSE
  200.       vorbereitet := FALSE;
  201.       WITH txRequest.ioSer.message DO
  202.         DeleteMsgPort(replyPort);
  203.         replyPort := NIL;
  204.       END;
  205.     END;
  206.   ELSE
  207.     vorbereitet := FALSE;
  208.   END;
  209.   RETURN vorbereitet;
  210. END SerialVorbereitet;
  211.  
  212.  
  213. PROCEDURE SetTermChars(serPtr : IOExtSerPtr);
  214.  
  215. BEGIN
  216.   WITH serPtr^ DO
  217.     ioSer.command := setParams;
  218.     INCL(serFlags, eofMode);
  219.     WITH termArray DO
  220.       termArray0 := 1C040303H; (* EOF-EOT-ETX-ETX *)
  221.       termArray1 := 03030303H; (* RTX-... *)
  222.     END;
  223.  
  224.     BreakPoint(NIL);
  225.  
  226.     DoIO(serPtr);
  227.   END;
  228. END SetTermChars;
  229.  
  230.  
  231. PROCEDURE SendeTextDatei(txDateiRequest : IOExtSer);
  232.  
  233. VAR txDateiHdl  : FileHandlePtr;
  234.     gelesen,
  235.     geschrieben : LONGINT;
  236.  
  237. BEGIN
  238.   geschrieben := FPuts(txWin, ADR(Senden));
  239.   SetTermChars(ADR(txDateiRequest));
  240.   txDateiRequest.ioSer.command := write;
  241.   txDateiHdl := Open(ADR("S:StartUp-Sequence"), oldFile);
  242.   IF txDateiHdl # NIL THEN
  243.     LOOP
  244.       WITH txDateiRequest.ioSer DO
  245.         gelesen := FRead(txDateiHdl, ADR(txPuffer), 1, SIZE(txPuffer));
  246.         IF gelesen # 0 THEN
  247.           length := gelesen;
  248.           DoIO(ADR(txDateiRequest));
  249.           geschrieben := Write(txWin, ADR("."), 1);
  250.         ELSE
  251.           EXIT;
  252.         END;
  253.         IF error # 0 THEN
  254.           EXIT;
  255.         END;
  256.       END;
  257.     END;
  258.     Close(txDateiHdl);
  259.   END;
  260.   geschrieben := FPuts(txWin, ADR(Beendet));
  261. END SendeTextDatei;
  262.  
  263.  
  264. PROCEDURE EmpfangeTextDatei(rxDateiRequest : IOExtSer);
  265.  
  266. VAR rxDatei      : FileHandlePtr;
  267.     geschrieben  : LONGINT;
  268.     queryRequest : IOExtSer;
  269.  
  270. BEGIN
  271.   geschrieben := FPuts(rxWin, ADR(Empfang));
  272.   SetTermChars(ADR(rxDateiRequest));
  273.  
  274.   queryRequest := rxDateiRequest;
  275.   queryRequest.ioSer.command := query;
  276.  
  277.   WITH rxDateiRequest DO
  278.     ioSer.command := read;
  279.     ioSer.length := 1;
  280.   END;
  281.   rxDatei := Open(ADR("RAM:Ser.tst"), newFile);
  282.   IF rxDatei # NIL THEN
  283.     LOOP
  284.       DoIO(ADR(rxDateiRequest));
  285.       IF rxDateiRequest.ioSer.actual # 0 THEN
  286.         geschrieben := FWrite(rxDatei, ADR(rxPuffer), 1, rxDateiRequest.ioSer.actual);
  287.         geschrieben := Write(rxWin, ADR("."), 1);
  288.       ELSE
  289.         EXIT;
  290.       END;
  291.       DoIO(ADR(queryRequest));
  292.       IF queryRequest.ioSer.actual = 0 THEN
  293.         EXIT;
  294.       ELSE
  295.         rxDateiRequest.ioSer.length := LONGINT(queryRequest.ioSer.actual);
  296.       END;
  297.     END; (* LOOP *)
  298.     Close(rxDatei);
  299.   END;
  300.   geschrieben := FPuts(rxWin, ADR(Beendet));
  301. END EmpfangeTextDatei;
  302.  
  303.  
  304. PROCEDURE TerminalLoop;
  305.  
  306. VAR inMsgPtr   : IntuiMessagePtr;
  307.     klasse     : IDCMPFlagSet;
  308.     done       : LONGINT;
  309.     erwartSig,
  310.     erhaltSig  : LONGSET;
  311.     raw        : INTEGER;
  312.  
  313. BEGIN
  314.   erwartSig := LONGSET{txWinPtr^.userPort^.sigBit};
  315.   INCL(erwartSig, rxRequest.ioSer.message.replyPort^.sigBit);
  316.   SendIO(ADR(rxRequest));
  317.   LOOP
  318.     erhaltSig := Wait(erwartSig);
  319.     IF txWinPtr^.userPort^.sigBit IN erhaltSig THEN
  320.       inMsgPtr := GetMsg(txWinPtr^.userPort);
  321.  
  322.       klasse := inMsgPtr^.class;
  323.       raw    := inMsgPtr^.code;
  324.  
  325.       ReplyMsg(inMsgPtr);
  326.  
  327.       IF (vanillaKey IN klasse) THEN
  328.         txPuffer[0] := CHAR(raw);
  329.         IF (txPuffer[0] # 033C) THEN
  330.           done := Write(txWin, ADR(txPuffer[0]), 1);
  331.           DoIO(ADR(txRequest));
  332.         ELSE
  333.           EXIT;
  334.         END;
  335.       ELSIF (rawKey IN klasse) THEN
  336.         IF (raw >= 80) AND (raw <= 89) THEN (* F1 = 80 *)
  337.  
  338.           (* Funktionstasten auswerten F1 - F10 *)
  339.  
  340.           IF raw = 80 THEN
  341.             SendeTextDatei(txRequest);
  342.           ELSIF raw = 81 THEN
  343.             EmpfangeTextDatei(rxRequest);
  344.           END;
  345.  
  346.         END;
  347.       END;
  348.     END;
  349.     IF rxRequest.ioSer.message.replyPort^.sigBit IN erhaltSig THEN
  350.       WaitIO(ADR(rxRequest));
  351.       IF rxRequest.ioSer.error = 0 THEN
  352.         done := Write(rxWin, ADR(rxPuffer[0]), 1);
  353.       END;
  354.       WITH rxRequest.ioSer DO
  355.         command := query;
  356.         DoIO(ADR(rxRequest));
  357.         command := read;
  358.         IF actual > 0 THEN
  359.           length := actual;
  360.           DoIO(ADR(rxRequest));
  361.           done := Write(rxWin, ADR(rxPuffer), actual);
  362.           length := 1;
  363.         END;
  364.       END;
  365.  
  366.       SendIO(ADR(rxRequest));
  367.     END;
  368.   END;
  369.   AbortIO(ADR(rxRequest));
  370.   WaitIO(ADR(rxRequest));
  371. END TerminalLoop;
  372.  
  373.  
  374. PROCEDURE FlushSerialDevice;
  375.  
  376. VAR serDev : ADDRESS;
  377.  
  378. BEGIN
  379.   serDev := FindName(ADR(execBase^.deviceList), ADR(serialName));
  380.   IF serDev # NIL THEN
  381.     Forbid();
  382.     RemDevice(serDev);
  383.     Permit();
  384.   END;
  385. END FlushSerialDevice;
  386.  
  387.  
  388. PROCEDURE Aufraeumen;
  389. BEGIN
  390.   DeleteMsgPort(rxRequest.ioSer.message.replyPort);
  391.   CloseDevice(ADR(rxRequest));
  392.   DeleteMsgPort(txRequest.ioSer.message.replyPort);
  393.   CloseDevice(ADR(txRequest));
  394.   Close(rxWin);
  395.   Close(txWin);
  396.   FlushSerialDevice;
  397. END Aufraeumen;
  398.  
  399.  
  400. BEGIN
  401.   IF kickVersion >= 36 THEN
  402.     IF WindowsAngelegt() AND SerialVorbereitet() THEN
  403.       TerminalLoop;
  404.       Aufraeumen;
  405.     ELSE
  406.       returnVal := -11;
  407.     END;
  408.   END;
  409. END Terminal.
  410.